home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / COT.CMD < prev    next >
OS/2 REXX Batch file  |  1997-03-09  |  5KB  |  139 lines
  1. /* REXX-Programm cot.cmd                  */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    Signal on syntax name cotMsg
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    NDAcot=Pfd||"NDAcot.DAT"
  13.    bufND =Pfd||"NDZahl.DAT"
  14.    bufMsg=Pfd||"Meldung.DAT"
  15.    ND = LineIn(bufND, 1)
  16.    NUMERIC DIGITS ND+14
  17.  
  18.    arg xx,y
  19.    p0p=xx*xx /* Diese Anweisung porvoziert eine Syntax-Fehlermeldung */
  20.  
  21.    if length(y) > 0 then
  22.    do
  23.      call charout(NDAcot) ; Call SysFileDelete NDAcot
  24.      ret=LineOut(bufMsg, "Im Argument von  cot(..) ist mindestens  1  nicht zulässiges Komma !")
  25.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  26.   /*  damit in den diesbezüglichen temporären Dateien                      */
  27.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  28.      EXIT
  29.    end
  30.  
  31.    if ND > 450 then
  32.    do
  33.      ND=450
  34.      call charout(NDAcot) ; Call SysFileDelete NDAcot
  35.      ret=LineOut(NDAcot, 450)
  36.      Call Charout,"   Achtung, nur 450 Dezimalstellen bei der Berechnung von   cot(...)"
  37.      say
  38.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  39.    end
  40.  
  41.    /* Wenn ND <= 450 ist, wird ND = ND  weitergegeben */
  42.    call charout(NDAcot) ; Call SysFileDelete NDAcot
  43.    ret=LineOut(NDAcot, ND)
  44.  
  45.    if xx = 0 then
  46.    do
  47.      call charout(NDAcot) ; Call SysFileDelete NDAcot
  48.      ret=LineOut(bufMsg, "Achtung, für  x=0  ist die Cotangensfunktion nicht definiert !")
  49.    /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  50.    /*  damit in den diesbezüglichen temporären Dateien                      */
  51.    /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  52.      EXIT
  53.    end
  54.  
  55.    pi=3.||,
  56.    1415926535897932384626433832795028841971693993751058209749445923078||,
  57.    164062862089986280348253421170679821480865132823066470938446095505822317||,
  58.    253594081284811174502841027019385211055596446229489549303819644288109756||,
  59.    659334461284756482337867831652712019091456485669234603486104543266482133||,
  60.    936072602491412737245870066063155881748815209209628292540917153643678925||,
  61.    903600113305305488204665213841469519415116094330572703657595919530921861||,
  62.    173819326117931051185480744623799627495673518857527248912279381830119491||,
  63.    298336733624406566430860213949463952247371907021798609437027705392171762||,
  64.    93176752384674818467669405132
  65.  
  66.    pi14=pi/4; /* = π/4 */  pi24=pi/2  /* = π/2  */
  67.  
  68.    /* x bleibt im Intervall  0 < x < 2π  */
  69.    x=abs(xx)//(2*pi)
  70.    /* x bleibt im Intervall  0 < x < π   */
  71.    x=x//pi
  72.  
  73.    NUMERIC DIGITS ND+10
  74.    vzs=1; vzc=1
  75.    /* Das Intervall  0 < x < 2*pi  wird so zerlegt, daß die Reihen für     */
  76.    /* sin(x)  und  cos(x)  immer nur für Werte  x < π/4  verwendet werden. */
  77.    /* vzs ist ein internes Vorzeichen sür die sinus-Reihe                  */
  78.    /* vzc ist ein internes Vorzeichen sür die cosinus-Reihe                */
  79.    select
  80.      when x > 3*pi14 then do; x = pi-x;    vzs=+1;  vzc=-1; Signal A; end
  81.      when x > 2*pi14 then do; x = x-pi/2;  vzs=+1;  vzc=-1; Signal B; end
  82.      when x >   pi14 then do; x = pi/2-x;  vzs=+1;  vzc=+1; Signal C; end
  83.      when x >   0    then do; x = x;       vzs=+1;  vzc=+1; Signal D; end
  84.      otherwise NOP
  85.    end
  86.  
  87.    /* yz = Wert des Zählers;  yn = Wert des Nenners */
  88. A: yz=cos(x,ND,vzs); yn=sin(x,ND,vzc); Signal W
  89. B: yz=sin(x,ND,vzc); yn=cos(x,ND,vzs); Signal W
  90. C: yz=sin(x,ND,vzc); yn=cos(x,ND,vzs); Signal W
  91. D: yz=cos(x,ND,vzs); yn=sin(x,ND,vzc);
  92.  
  93. W: yy=yz/yn
  94.    numeric digits ND
  95.    return(Format(sign(xx)*yy))
  96.  
  97. EXIT
  98.  
  99. Sin:
  100.    Procedure
  101.    /* Reihe sin(x) */
  102.    arg x,ND,vzs
  103.    g=1; z=x**2 ; m=2; v=1
  104.    do forever
  105.      g=-g*z/(m*(m+1))
  106.      if abs(g/v) < 10**(-ND-7) then leave
  107.      v=v+g
  108.      m=m+2
  109.    end
  110.    ys=v*x*vzs
  111.    return(ys)
  112.  
  113. Cos:
  114.    Procedure
  115.    /* Reihe cos(x) */
  116.    arg x,ND,vzc
  117.    g=1; z=x**2; m=2; v=1
  118.    do forever
  119.      g=-g*z/(m*(m-1))
  120.      if (abs(g/v) < 10**(-ND-7)) then leave
  121.      v=v+g
  122.      m=m+2
  123.    end
  124.    yc=v*vzc
  125.    return(yc)
  126.  
  127. cotMsg:
  128.    sf=ErrorText(RC)
  129.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  130.    do
  131.      call charout(NDAcot) ; Call SysFileDelete NDAcot
  132.      ret=LineOut(bufMsg, "Sie haben in  cot(..)  kein gültiges Argument eingegeben !")
  133.    /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  134.    /*  damit in den diesbezüglichen temporären Dateien                      */
  135.    /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  136.      EXIT
  137.    end
  138.  
  139.